home *** CD-ROM | disk | FTP | other *** search
/ Over 1,000 Windows 95 Programs / Over 1000 Windows 95 Programs (Microforum) (Disc 1).iso / 1157 / source / scprn.dpr < prev    next >
Encoding:
Text File  |  1996-11-07  |  8.0 KB  |  234 lines
  1. program Scprn;
  2.  
  3. uses
  4.   SysUtils, WinTypes, WinProcs, Classes, Forms,
  5.   Printers, Dialogs, ScMain;
  6.  
  7. {$R *.RES}
  8.  
  9. function DibNumColors(pv: pointer): word;
  10. {given a pointer to a locked DIB, return the number of palette entries: 0,2,16, or 256}
  11. var
  12.     Bits: integer;
  13.     lpbi: PBITMAPINFOHEADER;
  14.     lpbc: PBITMAPCOREHEADER;
  15. begin
  16.     lpbi := PBITMAPINFOHEADER(pv);
  17.     lpbc := PBITMAPCOREHEADER(pv);
  18.     {
  19.     /*    With the BITMAPINFO format headers, the size of the palette
  20.      *    is in biClrUsed, whereas in the BITMAPCORE - style headers, it
  21.      *    is dependent on the bits per pixel ( = 2 raised to the power of
  22.      *    bits/pixel).
  23.      */
  24.     }
  25.     if (lpbi^.biSize <> sizeof(TBITMAPCOREHEADER)) then
  26.     begin
  27.         if (lpbi^.biClrUsed <> 0) then
  28.             Result := WORD(lpbi^.biClrUsed);
  29.         Bits := lpbi^.biBitCount;
  30.     end
  31.     else
  32.     begin
  33.         Bits := lpbc^.bcBitCount;
  34.     end;
  35.     Result := (1 shl Bits) and $01ff; {up to 8 bits, 2 ^ Bits - otherwise, 0.}
  36. end;
  37.  
  38. function LPBits(lpdib: PBITMAPINFOHEADER): pointer;
  39. { Given a pointer to a locked DIB, return a pointer to the actual bits (pixels) }
  40. var
  41.     dwColorTableSize: longint;
  42. begin
  43.     dwColorTableSize := longint( (DibNumColors(lpdib) * sizeof(TRGBQUAD)));
  44.     lpBits := pointer( longint(lpdib) + lpdib^.biSize + dwColorTableSize);
  45. end;
  46.  
  47. procedure PrintDIB( PrinterHandle: HDC; BHandle: HBitmap; UserScaleX, UserScaleY: Single;
  48.                     Center: TCenterState; AutoScale: Boolean);
  49.  function GetDibResX(Info: PBitmapInfoHeader): Single;
  50.  begin {DIB-resolution in dpi}
  51.     if (Info^.biXPelsPerMeter>0) and (Info^.biXPelsPerMeter<400000) then
  52.        Result:=Info^.biXPelsPerMeter*25.4/1000 {Resolution in dpi}
  53.     else
  54.        Result:=0; {Resolution =0 or greater than 10000dpi}
  55.  end;
  56.  function GetDibResY(Info: PBitmapInfoHeader): Single;
  57.  begin
  58.     if (Info^.biYPelsPerMeter>0) and (Info^.biYPelsPerMeter<400000) then
  59.        Result:=Info^.biYPelsPerMeter*25.4/1000 {Resolution in dpi}
  60.     else
  61.        Result:=0; {Resolution =0 or greater than 10000dpi}
  62.  end;
  63.  function GetPrnResX( h: HDC ): Single;
  64.  begin {Printerresolution in dpi}
  65.    if (GetDeviceCaps(h, logPixelsX)>0) and (GetDeviceCaps(h, logPixelsX)<10000) then
  66.       Result:=GetDeviceCaps(h, logPixelsX)
  67.    else
  68.       Result:=0;
  69.  end;
  70.  function GetPrnResY( h: HDC ): Single;
  71.  begin {Printerresolution in dpi}
  72.    if (GetDeviceCaps(h, logPixelsY)>0) and (GetDeviceCaps(h, logPixelsY)<10000) then
  73.       Result:=GetDeviceCaps(h, logPixelsY)
  74.    else
  75.       Result:=0;
  76.  end;
  77.  var
  78.     Info: PBitmapInfoHeader;
  79.     i: integer;
  80.     x,y,w,h: longint;
  81.     Offset, PageSize: TPoint;
  82.     ScaleX, ScaleY: Single;
  83. begin
  84.   Info:=GlobalLock(BHandle);
  85.   if (longint(Info)<>0) then begin
  86.         if (GetPrnResX(PrinterHandle)<>0) and (GetPrnResY(PrinterHandle)<>0) and
  87.            (GetDibResX(Info)<>0) and (GetDibResY(Info)<>0) and AutoScale then
  88.         begin
  89.           ScaleX:=GetPrnResX(PrinterHandle) / GetDibResX(Info);
  90.           ScaleY:=GetPrnResY(PrinterHandle) / GetDibResY(Info);
  91.         end else begin
  92.           ScaleX:=1;
  93.           ScaleY:=1;
  94.         end;
  95.         if (ScaleX>10000) or (ScaleY>10000) or (ScaleX<0.0001) or (ScaleY<0.0001) then
  96.         begin
  97.           ScaleX:=1;
  98.           ScaleY:=1;
  99.         end;
  100.         ScaleX:=UserScaleX*ScaleX;
  101.         ScaleY:=UserScaleY*ScaleY;
  102.         if Escape(PrinterHandle, GETPRINTINGOFFSET, 0, NIL, @Offset)<=0 then
  103.            Offset:=point(0,0);
  104.         { center the destination bitmap }
  105.         {if Escape(Printer.Canvas.Handle, GETPHYSPAGESIZE, 0, NIL, @PageSize)<=0 then}
  106.         PageSize:=point(GetDeviceCaps(PrinterHandle, HORZRES), GetDeviceCaps(PrinterHandle, VERTRES));
  107.         w:=round(Info^.biWidth*ScaleX);
  108.         h:=round(Info^.biHeight*ScaleY);
  109.         case Center of
  110.              tctNone: begin
  111.                       X:=0; Y:=0;
  112.                       end;
  113.              tctTopCenter: begin
  114.                            X:=(PageSize.X-w) div 2;
  115.                            Y:=0;
  116.                            Offset:=point(0,0);
  117.                            end;
  118.              tctCenter: begin
  119.                            X:=(PageSize.X-w) div 2;
  120.                            Y:=(PageSize.Y-h) div 2;
  121.                            Offset:=point(0,0);
  122.                         end;
  123.              tctBottomCenter: begin
  124.                            X:=(PageSize.X-w) div 2;
  125.                            Y:=(PageSize.Y-h);
  126.                            Offset.X:=0;
  127.                         end;
  128.              else     begin
  129.                       X:=0; Y:=0;
  130.                       end;
  131.         end;
  132.         i:=StretchDIBits( PrinterHandle,
  133.                           X-Offset.X, Y-Offset.Y, w, h,
  134.                           0, 0, Info^.biWidth, Info^.biHeight,
  135.                           LPBits(Info), PBitmapinfo(Info)^,
  136.                           DIB_RGB_COLORS, SRCCOPY);
  137.   end;
  138.   GlobalUnlock(BHandle);
  139. end;
  140.  
  141. function SetCopies( count: Integer ): Integer;
  142. var DevMode: TDevMode;
  143.     PrintDevice, PrintDriver,PrintPort,DriverName: array[0..255] of char;
  144.     PrintDeviceMode: THandle;
  145.     P: PDevMode;
  146. begin
  147.       Result:=count;
  148.       Printer.GetPrinter(PrintDevice,PrintDriver,PrintPort,PrintDeviceMode);
  149.       if PrintDeviceMode <> 0 then
  150.       begin
  151.         P := Ptr(PrintDeviceMode, 0);
  152.         if (P^.dmFields and DM_COPIES)= DM_COPIES then
  153.         begin
  154.           P^.dmCopies:=count;
  155.           Printer.SetPrinter(PrintDevice,PrintDriver,PrintPort,PrintDeviceMode);
  156.           Printer.GetPrinter(PrintDevice,PrintDriver,PrintPort,PrintDeviceMode);
  157.           if (P^.dmFields and DM_COPIES)= DM_COPIES then
  158.           begin
  159.             {substract the copies that the printer does for me}
  160.             Result:=Count-P^.dmCopies;
  161.           end;
  162.          end;
  163.        end;
  164.  end;
  165.  
  166. procedure StartPrinting;
  167. var
  168.    BHandle: HBitmap;
  169.    UserScaleX, UserScaleY: Single;
  170.    Center: TCenterState;
  171.    aScale,aCopies: Boolean;
  172.    i,Count: Integer;
  173.    PSettings: PGlobalSettings;
  174.    Settings: THandle;
  175.    c: array[0..255] of char;
  176. begin {start printjob from commandline}
  177.       BHandle:=0;
  178.       UserScaleX:=1.0; UserScaleY:=1.0;
  179.       Center:=tctTopCenter;
  180.       aScale:=True;
  181.       if ParamCount=1 then
  182.       begin
  183.            {Application.Messagebox('Params accepted','OK',MB_OK);}
  184.            Settings := StrToInt( ParamStr(1) );
  185.            if Settings<>0 then
  186.            begin
  187.              PSettings:=GlobalLock( Settings );
  188.              if PSettings<>nil then
  189.              begin
  190.                 with PSettings^ do
  191.                 begin
  192.                    BHandle:= BitmapHandle;
  193.                    UserScaleX:= ZoomX;
  194.                    UserScaleY:= ZoomY;
  195.                    Center:= CenterState;
  196.                    Count := NoOfCopies;
  197.                    aScale := AutoScale;
  198.                    aCopies:= PrinterCopies;
  199.                    Printer.SetPrinter(PrintDevice,PrintDriver,PrintPort,PrintDeviceMode);
  200.                 end;
  201.              end;
  202.              GlobalUnlock( Settings );
  203.              GlobalFree(Settings);
  204.            end;
  205.            if BHandle<>0 then
  206.            begin
  207.               with Printer do begin
  208.                    Printer.Title:='ScPrn: '+IntToStr(Settings);
  209.                    try
  210.                       SetCopies(1);
  211.                       if aCopies then
  212.                          Count:=SetCopies(Count); {look that the printer does the copies}
  213.                       repeat
  214.                         BeginDoc;
  215.                         PrintDIB(Canvas.Handle, BHandle, UserScaleX, UserScaleY, Center, aScale );
  216.                         EndDoc;
  217.                         Count:=Count-1;
  218.                       until Count<1;
  219.                    finally;
  220.                       GlobalFree( BHandle );
  221.                    end;
  222.               end;
  223.            end;
  224.       end else
  225.           ShowMessage('This program is called from sc.exe. Version 2.0');
  226. end;
  227.  
  228. begin
  229.    {wait until previous instance has finished printing} 
  230.    while (GetInstanceModule( HPrevInst )<>0) do
  231.          Application.ProcessMessages;
  232.    StartPrinting;
  233. end.
  234.